home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 3.iso / dist / fw_rpm.idb / usr / freeware / lib / rpm / perl.prov.z / perl.prov
Text File  |  2000-01-25  |  3KB  |  113 lines
  1. #!/usr/bin/perl
  2.  
  3. # a simple script to print the proper name for perl libraries.
  4.  
  5. # I plan to rewrite this in C so that perl is not required by RPM at
  6. # build time.
  7.  
  8. # by Ken Estes Mail.com kestes@staff.mail.com
  9.  
  10. # it would be much better if perl could tell us the proper name of a
  11. # given script.
  12.  
  13.  
  14. if ("@ARGV") {
  15.   foreach (@ARGV) {
  16.     process_file($_);
  17.   }
  18. } else {
  19.  
  20.   # notice we are passed a list of filenames NOT as common in unix the
  21.   # contents of the file.
  22.  
  23.   foreach (<>) {
  24.     process_file($_);
  25.   }
  26. }
  27.  
  28.  
  29. foreach $module (sort keys %require) {
  30.   if (length($require{$module}) == 0) {
  31.     print "perl($module)\n";
  32.   } else {
  33.     print "perl($module)=$require{$module}\n";
  34.  
  35.     # we need to print it without the version number until the
  36.     # requires syntax accepts version numbers correctly.
  37.  
  38.     print "perl($module)\n";
  39.   }
  40. }
  41.  
  42. exit 0;
  43.  
  44.  
  45.  
  46. sub process_file {
  47.  
  48.   my ($file) = @_;
  49.   chomp $file;
  50.   
  51.   open(FILE, "<$file")||
  52.     die("Could not open file: '$file' : $!\n");
  53.  
  54.   my ($package, $version) = ();
  55.  
  56.   while (<FILE>) {
  57.     
  58.     # skip the documentation
  59.     if ( (m/^=(head1|head2|pod)/) .. (m/^=(cut)/) ) {
  60.       next;
  61.     }
  62.     
  63.     # skip the data section
  64.     if (m/^__(DATA|END)__$/) {
  65.       last;
  66.     }
  67.  
  68.     # not everyone puts the package name of the file as the first
  69.     # package name so we report all namespaces as if they were
  70.     # provided packages (really ugly).
  71.  
  72.     if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) {
  73.       $package=$1;
  74.       undef $version;
  75.       $require{$package}=undef;
  76.     }
  77.  
  78.     # after we found the package name take the first assignment to
  79.     # $VERSION as the version number. Exporter requires that the
  80.     # variable be called VERSION so we are safe.
  81.  
  82.     # here are examples of VERSION lines from the perl distribution
  83.  
  84.     #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
  85.     #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.1 $, 10;
  86.     #CGI/Apache.pm:$VERSION = (qw$Revision: 1.1 $)[1];
  87.     #DynaLoader.pm:$VERSION = $VERSION = "1.03";     # avoid typo warning
  88.  
  89.     if ( 
  90.     ($package) && 
  91.     (m/^\s*\$VERSION\s+=\s+/)
  92.        ) {
  93.  
  94.       # first see if the version string contains the string
  95.       # '$Revision' this often causes bizzare strings and is the most
  96.       # common method of non static numbering.
  97.  
  98.       if (m/(\$Revision: (\d+[.0-9]+))/) {
  99.     $version= $2; 
  100.       } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) {
  101.     
  102.     # look for a static number hard coded in the script
  103.     
  104.     $version= $1; 
  105.       }
  106.       $require{$package}=$version;
  107.     }
  108.     
  109.   }
  110.  
  111.   return ;
  112. }
  113.